home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / TSPA3370.ZIP / TSUNTD.INT < prev    next >
Text File  |  1992-06-13  |  7KB  |  169 lines
  1. {$B-,D-,F-,I+,N-,R-,S+,V+}
  2.  
  3. (*
  4. Timo Salmi UNiT D
  5. A Turbo Pascal unit for string manipulation and so on.
  6. All rights reserved 2-Aug-89,
  7. Updated 3-Aug-89, 19-Aug-89, 26-Sep-89, 13-Jun-90, 15-Jul-90, 5-Jan-91
  8.  
  9. This unit contains mainly string manipulation routines. There is not anything
  10. novel about the string routines. Just that I have tried to make them compact
  11. and fast. No inline code, though, is involved in this (nor the other) units.
  12. Well, starting from the 15-Jul-90 release (in tspas20.arc) this no longer
  13. holds. I have tried to upderstand some assembler and have included also
  14. inline code. Be warned that I cannot give any guarantees that the inline
  15. coded routines won't cause confusion.  Where inline code has been used,
  16. I have stated so.
  17.  
  18. This unit may be used and distributed freely for PRIVATE, NON-COMMERCIAL,
  19. NON-INSTITUTIONAL purposes, provided it is not changed in any way. For
  20. ANY other usage, such as use in a business enterprise or a university,
  21. contact the author for the terms of registration.
  22.  
  23. The units are under development. Comments and contacts are solicited. If
  24. you have any questions, please do not hesitate to use electronic mail for
  25. communication.
  26. InterNet address: ts@chyde.uwasa.fi         (preferred)
  27. Funet address:    GADO::SALMI
  28. Bitnet address:   SALMI@FINFUN
  29.  
  30. The author shall not be liable to the user for any direct, indirect or
  31. consequential loss arising from the use of, or inability to use, any unit,
  32. program or file howsoever caused. No warranty is given that the units and
  33. programs will work under all circumstances.
  34.  
  35. Timo Salmi
  36. Professor of Accounting and Business Finance
  37. Faculty of Accounting & Industrial Management; University of Vaasa
  38. P.O. BOX 297, SF-65101 Vaasa, Finland
  39. *)
  40.  
  41. unit TSUNTD;
  42.  
  43. (* ======================================================================= *)
  44.                           interface
  45. (* ======================================================================= *)
  46.  
  47. uses Dos;
  48.  
  49. (* =======================================================================
  50.                    String handling routines
  51.    ======================================================================= *)
  52.  
  53. (* Trim a string right *)
  54. function TRIMRGFN (original : string; atcolumn : byte) : string;
  55.  
  56. (* Trim a string left *)
  57. function TRIMLFFN (original : string; atcolumn : byte) : string;
  58.  
  59. (* Lead a string with a suitable number of chosen characters *)
  60. function LEADFN (original     : string;
  61.                  total_length : byte;
  62.                  leadwith     : char) : string;
  63.  
  64. (* Trail a string with a suitable number of chosen characters *)
  65. function TRAILFN (original     : string;
  66.                   total_length : byte;
  67.                   trailwith    : char) : string;
  68.  
  69. (* The opposite of Turbo Pascal's own UpCase function. This one is inline
  70.    coded so that it should be fast. *)
  71. function LOWCASFN (ch : char) : char;
  72.  
  73. (* =======================================================================
  74.                    String parsing routines
  75.    ======================================================================= *)
  76.  
  77. const parse_parts_max   = 255;
  78. type parseVectorType    = array [1..parse_parts_max] of string;
  79.      parseVectorPtrType = ^parseVectorType;
  80.  
  81. (* Extract all substrings from a string *)
  82. procedure PARSE
  83.   (original          : string;
  84.    parse_parts_max   : integer;
  85.    separators        : string;
  86.    var nber_of_parts : integer;
  87.    var partPtr       : parseVectorPtrType;
  88.    var ok            : boolean);          {no errors detected}
  89.  
  90. (* This, and the following function, are alternatives to the PARSE procedure.
  91.    STRCNTFN and SPARTFN resemble more closely the inbuilt ParamCount and
  92.    ParamStr function. They do not require using pointers as PARSE does.
  93.    These two functions first appear in release tspas14.arc.
  94.    The purpose of STRCNTFN is to return the number of substrings in a string.
  95.    This is "the second generation" of my string parsers.
  96. *)
  97. function STRCNTFN (s : string; separators : string) : integer;
  98.  
  99. (* Returns the specified substring in a string *)
  100. function SPARTFN (s          : string;
  101.                   separators : string;
  102.                   PartNumber : integer) : string;
  103.  
  104. (* Number of substrings in a string.
  105.    This is "the third generation" of my string parsers.
  106.    This is much faster and more concise, but it uses all the ascii
  107.    characters below ascii 33 as separators, that is, there is no choice *)
  108. function PARSENFN (sj : string) : integer;
  109.  
  110. (* Get a substring from a string.
  111.    Returns '' if PartNumber is out of range.
  112.    This is "the third generation" of my string parsers.
  113.    This is much faster and more concise, but it uses all the ascii
  114.    characters below ascii 33 as separators, that is, there is no choice *)
  115. function PARSERFN (sj : string; PartNumber : integer) : string;
  116.  
  117. (* =======================================================================
  118.                       Crt replacements
  119.    ======================================================================= *)
  120.  
  121. (*
  122. Turbo Pascal's own units may occasionally cause problems when run on
  123. poorly compatible computers. In particular, the Ctr unit is problematic
  124. in this respect. The dosdelay procedure is a replacement of Turbo Pascal's
  125. own Delay procedure which is in the Crt unit. The accuracy of dosdelay
  126. is not as good as Delay's. Another reason for avoiding Crt is the potential
  127. problems if the program uses redirection.
  128. *)
  129. procedure DOSDELAY (milliseconds : word);
  130.  
  131. (*
  132. AUDIO is a replacement and enhancement of Turbo Pascal's sound procedure.
  133. AUDIO does not need the Crt unit, and it takes the duration of the sound
  134. as a parameter in milliseconds. This procedure first appears in release
  135. tspas19 of this collection. AUDIO has been written in collaboration with
  136. Ari Hovila, ajh@chyde.uwasa.fi.
  137. *)
  138. procedure AUDIO (frequency : longint; duration : word);
  139.  
  140. (* =======================================================================
  141.                   What about the printer
  142.    ======================================================================= *)
  143.  
  144. (* Is the parallel printer online. This works for the printers I have, but
  145.    there are differences in computer-printer configurations which may
  146.    affect this function. In fact, I've now found configurations where
  147.    this test fails and I've written an alternative method which is below *)
  148. function PRTONLFN : boolean;
  149.  
  150. (* Is the first (lpt1) printer online. An alternative for cases where prtonln
  151.    fails. Elicits a very quick response directly from the printer I/O *)
  152. function LPTONLFN : boolean;
  153.  
  154. (* Send the current screen to printer. First check the printer status. *)
  155. procedure PRTSCR;
  156.  
  157. (* Get the number of times I/O is attempted for the printer in the first
  158.    parallel port before an error condition arises. The default is normally
  159.    20 times. (As you know I/O errors can be trapped with IORresult if I/O
  160.    checking has been turned off using the $I- compiler directive. *)
  161. function GETPRTFN : byte;
  162.  
  163. (* Set the number of times I/O is attempted to the printers for all the
  164.    parallel ports before an error condition arises. If the argument
  165.    is zero, the ports are not reset *)
  166. procedure SETPRT (NumberOfRetrys : byte);
  167.  
  168.  
  169.